home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Trading on the Edge
/
Trading On The Edge - CD-ROM Toolkit (Wayzata Technology)(2031)(1994).bin
/
mac
/
Shared
/
Freeman
/
GAs.m
< prev
next >
Wrap
Text File
|
1994-01-11
|
11KB
|
314 lines
BeginPackage["GeneticAlgorithms`"]
f::usage = "f[x]"
flip::usage = "flip[x]"
newGenerate::usage = "newGenerate[pmutate,keyPhrase,pop,numGens]"
decodeBGA::usage = "decodeBGA[chromosome]"
selectOne::usage = "selectOne[foldedFitnessList,fitTotal]"
myXor::usage = "myXor[x,y]"
mutateBGA::usage = "mutateBGA[pmute,allel]"
crossOver::usage = "crossOver[pcross,pmutate,parent1,parent2]"
initPop::usage = "initPop[psize,csize]"
displayBest::usage = "displayBest[fitnessList,number2Print]"
bga::usage = "bga[pcross,pmutate,popInitial,fitFunction,numGens,printNum]"
sigmoid::usage = "sigmoid[x]"
initXorPop::usage = "initXorPop[psize,csize,ioPairs]"
decodeXorChrom::usage = "decodeXorChrom[chromosome]"
gaNetFitness::usage = "gaNetFitness[hiddenWts,outputWts,ioPairVectors]"
crossOverXor::usage = "crossOverXor[pcross,pmutate,parent1,parent2]"
gaXor::usage = "gaXor[pcross,pmutate,popInitial,numReplace,ioPairs,numGens,printNum]"
decodeXorGenotype::usage = "decodeXorGenotype[genotype]"
encodeNetGa::usage = "encodeNetGa[weight,len]"
randomPop::usage = "randomPop[psize,csize,ioPairs,numGens]"
Begin["`Private`"] (* begin the private context *)
f[x_] := 1+Cos[x]/(1+0.01 x^2)
flip[x_] := If[Random[]<=x,True,False]
newGenerate[pmutate_,keyPhrase_,pop_,numGens_] :=
Module[{i,newPop,parent,diff,matches,
index,fitness},
newPop=pop;
For[i=1,i<=numGens,i++,
diff = Map[(keyPhrase-#)&,newPop];
matches = Map[Count[#,0]&,diff];
fitness = Max[matches];
index = Position[matches,fitness];
parent = newPop[[First[Flatten[index]]]];
Print["Generation ",i,": ",FromCharacterCode[parent],
" Fitness= ",fitness];
newPop = Table[Map[mutateLetter[pmutate,#]&,parent],{100}];
]; (* end of For *)
]; (* end of Module *)
decodeBGA[chromosome_] :=
Module[{pList,lchrom,values,phenotype},
lchrom = Length[chromosome];
(* convert from binary to decimal *)
pList = Flatten[Position[chromosome,1] ];
values = Map[2^(lchrom-#)&,pList];
decimal = Apply[Plus,values];
(* scale to proper range *)
phenotype = decimal (0.07820136852394916911)-40;
Return[phenotype];
]; (* end of Module *)
selectOne[foldedFitnessList_,fitTotal_] :=
Module[{randFitness,elem,index},
randFitness = Random[] fitTotal;
elem = Select[foldedFitnessList,#>=randFitness&,1];
index =
Flatten[Position[foldedFitnessList,First[elem]]];
Return[First[index]];
]; (* end of Module *)
myXor[x_,y_] := If[x==y,0,1];
mutateBGA[pmute_,allel_] :=
If[flip[pmute],myXor[allel,1],allel];
crossOver[pcross_,pmutate_,parent1_,parent2_] :=
Module[{child1,child2,crossAt,lchrom },
(* chromosome length *)
lchrom = Length[parent1];
If[ flip[pcross],
(* True: select cross site at random *)
crossAt = Random[Integer,{1,lchrom-1}];
(* construct children *)
child1 = Join[Take[parent1,crossAt], Drop[parent2,crossAt]];
child2 = Join[Take[parent2,crossAt], Drop[parent1,crossAt]],
(* False: return parents as children *)
child1 = parent1;
child2 = parent2;
]; (* end of If *)
(* perform mutation *)
child1 = Map[mutateBGA[pmutate,#]&,child1];
child2 = Map[mutateBGA[pmutate,#]&,child2];
Return[{child1,child2}];
]; (* end of Module *)
initPop[psize_,csize_] :=
Table[Random[Integer,{0,1}],{psize},{csize}];
displayBest[fitnessList_,number2Print_] :=
Module[{i,sortedList},
sortedList = Sort[fitnessList,Greater];
For[i=1,i<=number2Print,i++,
Print["fitness = ",sortedList[[i]] ];
]; (* end of For i *)
]; (* end of Module *)
bga[pcross_,pmutate_,popInitial_,fitFunction_,numGens_,printNum_] :=
Module[{i,newPop,parent1,parent2,diff,matches,
oldPop,reproNum,index,fitList,fitListSum,
fitSum,pheno,pIndex,pIndex2,f,children},
oldPop=popInitial; (* initialize first population *)
reproNum = Length[oldPop]/2; (* calculate number of reproductions *)
f = fitFunction; (* assign the fitness function *)
For[i=1,i<=numGens,i++, (* perform numGens generations *)
pheno = Map[decodeBGA,oldPop]; (* decode the chromosomes *)
fitList = f[pheno]; (* determine the fitness of each phenotype *)
Print[" "]; (* print out the best individuals *)
Print["Generation ",i," Best ",printNum];
Print[" "];
displayBest[fitList,printNum];
fitListSum = FoldList[Plus,First[fitList],Rest[fitList]];
fitSum = Last[fitListSum]; (* find the total fitness *)
newPop = Flatten[Table[ (* determine the new population *)
pIndex1 = selectOne[fitListSum,fitSum]; (* select parent indices *)
pIndex2 = selectOne[fitListSum,fitSum];
parent1 = oldPop[[pIndex1]]; (* identify parents *)
parent2 = oldPop[[pIndex2]];
children = crossOver[pcross,pmutate,parent1,parent2]; (* crossover and mutate *)
children,{reproNum}],1 (* add children to list; flatten to first level *)
]; (* end of Flatten[Table] *)
oldPop = newPop; (* new becomes old for next gen *)
]; (* end of For i*)
]; (* end of Module *)
sigmoid[x_] := 1./(1+E^(-x));
initXorPop[psize_,csize_,ioPairs_] :=
Module[{i,iPop,hidWts,outWts,mseInv},
(* first the chromosomes *)
iPop = Table[
{Table[Random[Integer,{0,1}],{csize}],(* h1 *)
Table[Random[Integer,{0,1}],{csize}],(* h2 *)
Table[Random[Integer,{0,1}],{csize}] (* o1 *)
}, {psize} ]; (* end of Table *)
(* then decode and eval fitness *)
(* use For loop for clarity *)
For[i=1,i<=psize,i++,
(* make hidden weight matrix *)
hidWts = Join[iPop[[i,1]],iPop[[i,2]] ];
hidWts = Partition[hidWts,20];
hidWts = Map[decodeXorChrom,hidWts];
hidWts = Partition[hidWts,2];
(* make output weight matrix *)
outWts = Partition[iPop[[i,3]],20];
outWts = Map[decodeXorChrom,outWts];
(* get mse for this network *)
mseInv = gaNetFitness[hidWts,outWts,ioPairs];
(* prepend mseInv *)
PrependTo[iPop[[i]],mseInv];
]; (* end For *)
Return[iPop];
]; (* end of Module *)
decodeXorChrom[chromosome_] :=
Module[{pList,lchrom,values,p,decimal},
lchrom = Length[chromosome];
(* convert from binary to decimal *)
pList = Flatten[Position[chromosome,1] ];
values = Map[2^(lchrom-#)&,pList];
decimal = Apply[Plus,values];
(* scale to proper range *)
p = decimal (9.536752259018191355*10^-6)-5;
Return[p];
]; (* end of Module *)
gaNetFitness[hiddenWts_,outputWts_,ioPairVectors_] :=
Module[{inputs,hidden,outputs,desired,errors,
len,errorTotal,errorSum},
inputs=Map[First,ioPairVectors];
desired=Map[Last,ioPairVectors];
len = Length[inputs];
hidden=sigmoid[inputs.Transpose[hiddenWts]];
outputs=sigmoid[hidden.Transpose[outputWts]];
errors= desired-outputs;
errorSum = Apply[Plus,errors^2,2]; (* second level *)
errorTotal = Apply[Plus,errorSum];
(* inverse of mse *)
Return[len/errorTotal];
] (* end of Module *)
crossOverXor[pcross_,pmutate_,parent1_,parent2_] :=
Module[{child1,child2,crossAt,lchrom,
i,numchroms,chroms1,chroms2},
(* strip off mse *)
chroms1 = Rest[parent1];
chroms2 = Rest[parent2];
(* chromosome length *)
lchrom = Length[chroms1[[1]]];
(* number of chromosomes in each list *)
numchroms = Length[chroms1];
For[i=1,i<=numchroms,i++, (* for each chrom *)
If[ flip[pcross],
crossAt = Random[Integer,{1,lchrom-1}]; (* True: select cross site at random *)
(* construct children *)
chroms1[[i]] = Join[Take[chroms1[[i]],crossAt],Drop[chroms2[[i]],crossAt]];
chroms2[[i]] = Join[Take[chroms2[[i]],crossAt], Drop[chroms1[[i]],crossAt]],
Continue]; (* False: don't change chroms[[i]]. End of If *)
(* perform mutation *)
chroms1[[i]] = Map[mutateBGA[pmutate,#]&,chroms1[[i]]];
chroms2[[i]] = Map[mutateBGA[pmutate,#]&,chroms2[[i]]];
]; (* end of For i *)
Return[{chroms1,chroms2}];
]; (* end of Module *)
gaXor[pcross_,pmutate_,popInitial_,numReplace_,ioPairs_,numGens_,printNum_] :=
Module[{i,j,newPop,parent1,parent2,diff,matches,
oldPop,reproNum,index,fitList,fitListSum,
fitSum,pheno,pIndex,pIndex2,f,children,hids,outs,mseInv},
(* initialize first population sorted by fitness value *)
oldPop= Sort[popInitial,Greater[First[#],First[#2]]&];
reproNum = numReplace; (* calculate number of reproductions *)
For[i=1,i<=numGens,i++,
fitList = Map[First,oldPop]; (* list of fitness values*)
(* make the folded list of fitness values *)
fitListSum = FoldList[Plus,First[fitList],Rest[fitList]];
fitSum = Last[fitListSum]; (* find the total fitness *)
newPop = Drop[oldPop,-reproNum]; (* new population; eliminate reproNum worst *)
For[j=1,j<=reproNum/2,j++, (* make reproNum new children *)
(* select parent indices *)
pIndex1 = selectOne[fitListSum,fitSum];
pIndex2 = selectOne[fitListSum,fitSum];
parent1 = oldPop[[pIndex1]]; (* identify parents *)
parent2 = oldPop[[pIndex2]];
children = crossOverXor[pcross,pmutate,parent1,parent2];(*cross and mutate*)
{hids,outs} = decodeXorGenotype[children[[1]] ]; (* fitness of children *)
mseInv = gaNetFitness[hids,outs,ioPairs];
children[[1]] = Prepend[children[[1]],mseInv];
{hids,outs} = decodeXorGenotype[children[[2]] ];
mseInv = gaNetFitness[hids,outs,ioPairs];
children[[2]] = Prepend[children[[2]],mseInv];
newPop = Join[newPop,children]; (* add children to new population *)
]; (* end of For j *)
oldPop = Sort[newPop,Greater[First[#],First[#2]]&];(* for next gen *)
(* print best mse values (1/mseInv) *)
Print[ ];Print["Best of generation ",i];
For[j=1,j<=printNum,j++,Print[(1.0/oldPop[[j,1]])]; ];
]; (* end of For i*)
Return[oldPop];
]; (* end of Module *)
decodeXorGenotype[genotype_] :=
Module[{hidWts,outWts},
hidWts = Join[genotype[[1]],genotype[[2]] ];
hidWts = Partition[hidWts,20];
hidWts = Map[decodeXorChrom,hidWts];
hidWts = Partition[hidWts,2];
(* make output weight matrix *)
outWts = Partition[genotype[[3]],20];
outWts = Map[decodeXorChrom,outWts];
Return[{hidWts,outWts}];
];
encodeNetGa[weight_,len_] :=
Module[{pList,values,dec,chromosome,i},
i=len;
l=Table[0,{i}];
(* scale to proper range *)
dec = Round[(weight+5.)/(9.536752259018191355*10^-6)];
While[dec!=0&&dec!=1,
l=ReplacePart[l,Mod[dec,2],i];
dec=Quotient[dec,2];
--i;
];
l=ReplacePart[l,dec,i]
]; (* end of Module *)
randomPop[psize_,csize_,ioPairs_,numGens_] :=
Module[{i,pop},
For[i=1,i<=numGens,i++,
pop = initXorPop[psize,csize,ioPairs];
pop = Sort[pop,Greater[First[#],First[#2]]&];
Print[ ];
Print["Random generation ",i];
Print[(1.0/pop[[1,1]])];
];
];
End[] (* end the private context *)
EndPackage[] (* end the package context *)